Proyecto de Contingencias de Vida I

Estudiantes

Erick Venegas Espinoza - C09319

Eduardo López Corella - C24343

Gerard Gabert Hidalgo - B93096

Javier Hernández Navarro - C13674

Juan Pablo Morgan Sandí - C15319

2024-06-29

Antecedentes

source('code/antecedentes.R')
## `summarise()` has grouped output by 'edad'. You can override using the
## `.groups` argument.
## New names:

Variacion Interanual

Tasa básica pasiva

### Poblaciones #### Tasas de mortalidad

Esperanzas al nacer

Empleados de la empresa ABC

Primer ejercicio

Punto A

  tablas_activos <- proyeccion_demografica_activos(base_empleados, tablas_supen)

llamamos es script con los gráficos.

source('code/graficos_activos.R')
fig_activos_vivos

Punto B

Punto C

fig_activos_muertos

Punto D

Punto E

Para esta sección, se toman las proyecciones demográficas ya hechas anteriormente.

En primer lugar, creamos las tablas en cuestión que nos ayudarán a graficar.

tabla_proy_fin <- proyeccion_financiera(tablas_activos, inflacion =  0.03)

Punto F

Punto G

Punto H

Estas son las primas para cada empleado tasa tomando en cuenta la inflación por medio de la ecuación de Fisher (1+i) = (1+tasa_real)(1+inflación), en este caso 0.0712 utilizando 0.04 tasa real y 0.03 de la inflación.

#Primas para empleados 
Primas<-Calcula_prima_individuales(base_empleados,tablas_supen,5000000,1000000,300000,0.04)

#Base de empleados de combinaciones únicas 
base_unicas<- unico(base_empleados)

#Primas para empleados, Hombre o Mujer y su respectiva edad 
Primas_unicas <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.04)
Primas_unicas <- Primas_unicas%>%
                  mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
                  select(-c(`Empleado`,`anualidad`,`beneficios`))

Punto I

Para la prima nivelada, se toman la suma de las esperanzas de los beneficios futuros y se divide por la suma de las esperanza del valor presente de las primas futuras, dando como resultado la prima nivelada anual.

## [1] 1252880

Punto J

Dado que la idea de este ejercicio es reducir las primas un 10%, calculo cuál es la suma que representa el 90% de las primas originales, para acercarnos a ellas.

#Calcula cuánto es el 90% de las primas obtenidas
Primas_90_porciento <- data.frame(Empleado = Primas$Empleado,
                                  Menos_10_porciento = (Primas$Primas)*0.9)

La primera alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 5 millones durante el tiempo de ser empleado activo
# Suma asegurada de 5 millones durante pensión 
# Primer año de pensión con mensualidad de 266.520 colones
Primas1_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,5000000,5000000,266520,0.04)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica1_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas1_menos_10$Primas, 
                                    porcentaje= (Primas1_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica1_90_porciento$porcentaje)/nrow(Verifica1_90_porciento))
## [1] 90.05992

La Segunda alternativa para reducir la prima 10%:

# Se calculan primas con:
# Suma asegurada de 1 millón durante el tiempo de ser empleado activo
# Suma asegurada de 1 millón durante pensión 
# Primer año de pensión con mensualidad de 271.900 colones
Primas2_menos_10 <- Calcula_prima_individuales(base_empleados,tablas_supen,1000000,1000000,271900,0.04)

#se usa regla de 3 para verificar que la nueva prima sea aproximadamente el 90% de la original
Verifica2_90_porciento = data.frame(original_90 = Primas_90_porciento$Menos_10_porciento, 
                                    editada = Primas2_menos_10$Primas, 
                                    porcentaje= (Primas2_menos_10$Primas / Primas$Primas) * 100)

#Imprime el porcentaje promedio que representan las nuevas primas de las originales
print(sum(Verifica2_90_porciento$porcentaje)/nrow(Verifica2_90_porciento))
## [1] 90.02407
#Primas para empleados, Hombre o Mujer y su respectiva edad 
Primas_unicas_0.05 <- Calcula_prima_individuales(base_unicas,tablas_supen,5000000,1000000,300000,0.05)
Primas_unicas_0.05 <- Primas_unicas_0.05%>%
                  mutate(Sexo = if_else(Sexo == 1,'Hombre', 'Mujer')) %>%
                  select(-c(`Empleado`,`anualidad`,`beneficios`))

tabla_para_graficar_distinta_tasa <- data.frame( sexo = Primas_unicas$Sexo,
                                                 edad = Primas_unicas$Edad,
                                                 primas_normales = Primas_unicas$Primas,
                                                 primas_tasa_aumentada = Primas_unicas_0.05$Primas,
                                                 variación = (Primas_unicas_0.05$Primas-Primas_unicas$Primas)/Primas_unicas$Primas )

tabla_distinta_tasa_hombres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Hombre", ]
tabla_distinta_tasa_mujeres <- tabla_para_graficar_distinta_tasa[tabla_para_graficar_distinta_tasa$sexo == "Mujer", ]

Modelo estocástico

El siguiente chunck puede ejecutar las simulaciones, pero para efectos del informe, se tienen los valores guardados en un csv El mismo corre 100.000 simulaciones, en aproximadamente 3,5 minutos

primas_modelo_estocastico <- realizar_simulaciones(base_empleados, 100000, 0.04)

Se importan los resultados de las simulaciones

simulaciones <- read_csv('docs/primas_cuartiles_t.csv')
## Rows: 90 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (2): 50%, 90%
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
combinaciones_unicas <- base_empleados %>%
  arrange(edad, sexo) %>% 
  select(edad, sexo) %>%
  distinct()
resultados <- cbind(combinaciones_unicas, simulaciones)
colnames(resultados) <- c('Edad', 'Sexo', 'Cuartil 50', 'Cuartil 90')

resultados_hombres <- subset(resultados, Sexo == '1') %>% select(-Sexo)
resultados_mujeres <- subset(resultados, Sexo == '2') %>% select(-Sexo)

Resultados de las primas para hombres

resultados_hombres
##    Edad Cuartil 50 Cuartil 90
## 1    20   702279.8   857664.2
## 3    21   732845.2   894992.5
## 5    22   746901.2   922918.4
## 7    23   779819.6   963594.4
## 9    24   814429.3  1006360.3
## 11   25   850846.4  1051359.7
## 13   26   889198.6  1098750.0
## 15   27   929626.2  1148704.9
## 17   28   972284.4  1201416.1
## 19   29  1017345.0  1257095.9
## 21   30  1064999.1  1315980.3
## 23   31  1115459.6  1378332.5
## 25   32  1139611.5  1444446.8
## 27   33  1195002.0  1514653.7
## 29   34  1253915.3  1589325.8
## 31   35  1316684.1  1668884.7
## 33   36  1383686.5  1731549.0
## 35   37  1455354.0  1821233.9
## 37   38  1532181.9  1917376.5
## 39   39  1614740.9  2020691.1
## 41   40  1703693.1  2132006.0
## 43   41  1799810.2  2252287.2
## 45   42  1903998.1  2382668.3
## 47   43  1963288.0  2524488.5
## 49   44  2141071.3  2679342.3
## 51   45  2215770.6  2849142.7
## 53   46  2361248.8  3036205.3
## 55   47  2522353.0  3243360.8
## 57   48  2701802.8  3474105.7
## 59   49  2902997.5  3732811.5
## 61   50  3130243.8  4025015.5
## 63   51  3389079.0  4357838.1
## 65   52  3686745.3  4677209.3
## 67   53  4032899.9  5116360.1
## 69   54  4440712.7  5633734.0
## 71   55  4928623.2  6252724.3
## 73   56  5523268.4  7007124.1
## 75   57  6264605.6  7947625.5
## 77   58  7215428.1  9153891.7
## 79   59  8480395.1 10758698.8
## 81   60 10247897.5 13001050.1
## 83   61 12894723.4 16358960.1
## 85   62 17300054.0 21947806.4
## 87   63 26101446.4 33113740.0
## 89   64 52486714.3 66587551.8

Resultados de las primas para mujeres

resultados_mujeres
##    Edad Cuartil 50 Cuartil 90
## 2    20   762378.4   867607.7
## 4    21   795559.4   905368.7
## 6    22   830395.2   945012.7
## 8    23   866993.4   986662.5
## 10   24   888663.1  1030452.2
## 12   25   928399.6  1076528.8
## 14   26   970247.4  1125053.7
## 16   27  1014360.0  1176204.5
## 18   28  1060906.4  1230177.6
## 20   29  1110074.3  1287190.3
## 22   30  1162071.9  1347484.4
## 24   31  1217131.8  1411329.3
## 26   32  1275513.8  1479026.3
## 28   33  1337509.8  1533139.3
## 30   34  1403448.7  1608722.7
## 32   35  1444713.0  1689252.6
## 34   36  1518230.4  1775213.9
## 36   37  1596866.6  1867160.5
## 38   38  1681164.8  1965727.5
## 40   39  1771751.6  2071647.5
## 42   40  1869353.1  2185769.5
## 44   41  1974816.2  2309083.8
## 46   42  2089134.9  2442752.7
## 48   43  2213483.6  2588149.3
## 50   44  2349260.1  2746908.1
## 52   45  2450980.4  2920990.3
## 54   46  2606603.0  3112770.2
## 56   47  2784447.4  3325149.6
## 58   48  2982543.6  3561713.3
## 60   49  3204644.2  3826942.9
## 62   50  3455503.3  4126515.5
## 64   51  3741233.8  4467731.0
## 66   52  4069830.3  4801536.0
## 68   53  4451953.3  5252360.0
## 70   54  4902141.4  5783486.4
## 72   55  5440750.1  6418930.4
## 74   56  6097184.0  7193383.1
## 76   57  6915552.6  8158884.4
## 78   58  7965173.9  9397214.8
## 80   59  9154071.2 11044679.9
## 82   60 11061982.6 13346636.0
## 84   61 13919070.4 16793803.9
## 86   62 18674357.1 22531209.5
## 88   63 28174925.4 33993949.1
## 90   64 56656218.8 68357541.1